home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
nrpas13.arc
/
CALDAT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-01
|
653b
|
24 lines
PROCEDURE caldat(julian: integer; VAR mm,id,iyyy: integer);
CONST
igreg=2299161;
VAR
je,jd,jc,jb,jalpha,ja: integer;
BEGIN
IF (julian >= igreg) THEN BEGIN
jalpha := trunc(((julian-1867216)-0.25)/36524.25);
ja := julian+1+jalpha-trunc(0.25*jalpha)
END ELSE BEGIN
ja := julian
END;
jb := ja+1524;
jc := trunc(6680.0+((jb-2439870)-122.1)/365.25);
jd := 365*jc+trunc(0.25*jc);
je := trunc((jb-jd)/30.6001);
id := jb-jd-trunc(30.6001*je);
mm := je-1;
IF (mm > 12) THEN mm := mm-12;
iyyy := jc-4715;
IF (mm > 2) THEN iyyy := iyyy-1;
IF (iyyy <= 0) THEN iyyy := iyyy-1
END;